home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / eval_az.com / PRINTF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-06-19  |  7.3 KB  |  214 lines
  1.  
  2. { DATARAN Corp.  Dec 7 87  AMZ
  3.    numeric formatting functions
  4.  
  5.  
  6. functions include  FMTSTR(fmt,str);
  7.                    FMTINT(fmt,int);
  8.                    FMTREAL(fmt,real);
  9.                    FMTLONG(fmt, long)
  10.                    fmtbool(fmt,bool);
  11.                    fmtword(fmt,word);
  12.  
  13. All functions are based on FMTSTR, a general purpose string formatter.
  14. The format string contains control characters that tell fmtstr what to do.
  15. Available format controls are:
  16.    ,      Put nice commas in the formatted number
  17.    $      Put a dollar sign at front of number
  18.    Dn     Format number as a string with n decimal points, padding if reqd.
  19.    ,      Place commas into proper place or left of decimal point( if any)
  20.    Rnn    Place string right justified in a field nn long.
  21.    Lnn    Place string left justified in a fiels nn wide.
  22.    Cnn    Center string in a field nn wide.
  23.  
  24.    }
  25. unit printf;
  26.  
  27. interface
  28. uses testlib, tpstring;
  29.  
  30. function fmtstr(fstr: med_string; vstr : anystring) : anystring;  { string formatter }
  31.  
  32. function fmtint(fstr : med_string; number: integer) : anystring;     { integer}
  33. function fmtlong(fstr : med_string; number: longint) : anystring;     { integer}
  34. function fmtword(fstr : med_string; number: word) : anystring;     { integer}
  35. function fmtbool(fstr : med_string; bool: boolean): anystring;
  36.  
  37. function fmtreal(fstr : med_string; number: real) : anystring;
  38.  
  39. implementation
  40.  
  41. function fmtstr;
  42.  
  43. var
  44. tempstr     : maxstring;
  45. tempfmt     : string[10];
  46. len, dot,digits,i,commas  : integer;  { locals }
  47. code, places,original     : integer;
  48. zeroes                    : string[10];
  49.  
  50. begin                   { format function start }
  51.   zeroes := '0000000000';
  52.   tempstr := trim(vstr);      { pick up the variable string  without spaces}
  53.   tempfmt := stupcase(fstr);      { upper case format strint }
  54.   len := length(tempstr);     { length of packed string }
  55.  
  56.  
  57.   if pos(',',tempfmt) <> 0 then begin   { comma insertion }
  58.     dot := pos('.',tempstr);    { location of a decimal if any }
  59.  
  60.     if dot = 0 then dot := len+1  ;       { dot is 1 more than we fool with }
  61.     if copy(tempstr,1,1) <> '-' then
  62.     commas := (dot-2) div 3                   { numnber of commas needed }
  63.     else                                      { if a leading - present }
  64.     commas := (dot-3) div 3;
  65.  
  66.     if commas <> 0 then begin;               { at least 1 comma needed }
  67.       for i := 1 to commas do
  68.       insert(',' , tempstr, dot-(i*3) );
  69.     end;     { non zero number of commas needed }
  70.   end;       { comma routine }
  71.  
  72.   if pos('$',tempfmt) <> 0 then  tempstr := '$'+tempstr;  { add in bucks }
  73.  
  74. (*
  75. { -----   DECIMAL PLACE ADJUSTMENT -------}
  76.  
  77.   if pos('D',tempfmt) <> 0 then begin   { wants to specify decimal places }
  78.     dot := pos('.', tempstr);                { location of existing . }
  79.     i := pos('D',tempfmt)+1;
  80.     val(copy(tempfmt,i,1),places,code);  { number of places }
  81.  
  82.     if code = 0 then begin                   { valid number of decimals}
  83.       if (places = 0) and (dot <> 0) then    { needs decimals removed }
  84.         tempstr := copy(tempstr,1,dot-1);
  85.  
  86.       if (places <> 0) and (dot = 0) then
  87.           tempstr := tempstr + '.';         { add a . to start with }
  88.  
  89.       if (places <> 0) then begin           { make places correct }
  90.         dot := pos('.',tempstr);            { find out where . now is }
  91.         original := length( copy(tempstr,dot+1,50));  { orignal places }
  92.         if original < places then              { pad with zeroes }
  93.            tempstr := tempstr + copy(zeroes,1, places-original);
  94.         if original > places then begin        { truncate fraction }
  95.             len := length(tempstr);
  96.             tempstr := copy(tempstr,1, len-(original-places));
  97.             end;
  98.        end;                { desired places <> 0 }
  99.      end;             { valid number of places desired }
  100.    end;               { decimal palace correction desired }
  101. *)
  102.  
  103. {  LEFT RIGHT AND CENTER PROCEDURE  }
  104.  
  105.   if pos('L', tempfmt) <> 0 then begin    { left justify desired }
  106.     dot := pos('L',tempfmt);    { location of control }
  107.     val( copy(tempfmt,dot+1, 2),places, code);    { convert the width spec }
  108.     tempstr := trim(tempstr);
  109.     if length(tempstr) < places then
  110.       tempstr := pad(tempstr , places );  { pad out}
  111.    end;
  112.  
  113.   if pos('R', tempfmt) <> 0 then begin   { right justify }
  114.     dot := pos('R', tempfmt);
  115.     val( copy(tempfmt, dot+1,2), places,code);   { get wifth spec }
  116.     tempstr := trim(tempstr);
  117.     if length(tempstr) < places then
  118.       tempstr := leftpad(tempstr, places );
  119.    end;
  120.  
  121.   if pos('C', tempfmt) <> 0 then begin   { center justify }
  122.     dot := pos('C', tempfmt);
  123.     val( copy(tempfmt, dot+1, 2), places,code);  { get width }
  124.     tempstr := trim(tempstr);             { get rid of any possible spalces }
  125.     if (length(tempstr) < places ) and (code = 0) then begin
  126. (*
  127.       code := (places - length(tempstr)) div 2;  { white space fore and aft}
  128.       tempstr := bunch(' ',code) + tempstr + bunch(' ',code);
  129.  
  130.       if length(tempstr) < places then
  131.         tempstr := tempstr + bunch(' ', places-length(tempstr));
  132. *)
  133.        tempstr := center(tempstr,places);
  134.      end;
  135.   end;                { end of center operation }
  136.  
  137.   fmtstr := tempstr;             { assign to function variable }
  138.  
  139. end;     { end of format function }
  140.  
  141.  
  142. function fmtbool;
  143. var
  144. temp1   : string[30];
  145. begin
  146.   if bool then temp1 := 'True' else temp1 := 'False';  {d efault}
  147.   if pos( 'Y',stupcase(fstr)) <> 0 then begin
  148.     if bool then temp1 := 'Yes' else temp1 := 'No';
  149.   end;
  150.   if pos( 'T',stupcase(fstr)) <> 0 then begin
  151.     if bool then temp1 := 'True' else temp1 := 'False';
  152.   end;
  153.   if pos( 'N',stupcase(fstr)) <> 0 then begin
  154.     if bool then temp1 := '1' else temp1 := '0';
  155.   end;
  156.   if pos( 'O',stupcase(fstr)) <> 0 then begin
  157.     if bool then temp1 := 'On' else temp1 := 'Off';
  158.   end;
  159.  
  160.  
  161.   fmtbool := fmtstr(fstr,temp1)   { use regular string converter }
  162. end;
  163.  
  164.  
  165. function fmtint;
  166. var
  167. temp1   : string[30];
  168. begin
  169.   str(number,temp1);            { create a string from integer }
  170.   temp1 := trim(temp1);         { get rid of all spaces }
  171.   fmtint := fmtstr(fstr,temp1)   { use regular string converter }
  172. end;
  173.  
  174. function fmtlong;
  175. var
  176. temp1   : string[30];
  177. begin
  178.   str(number,temp1);            { create a string from integer }
  179.   temp1 := trim(temp1);         { get rid of all spaces }
  180.   fmtlong := fmtstr(fstr,temp1)   { use regular string converter }
  181. end;
  182.  
  183. function fmtword(fstr : med_string; number: word) : anystring; { integer }
  184. var
  185. temp1   : string[30];
  186. begin
  187.   str(number,temp1);            { create a string from word }
  188.   temp1   := trim(temp1);         { get rid of all spaces }
  189.   fmtword := fmtstr(fstr,temp1)   { use regular string converter }
  190. end;
  191.  
  192.  
  193. function fmtreal(fstr : med_string; number: real) : anystring;
  194.  
  195. var
  196. temp1   : string[30];
  197. tempfmt : small_string;
  198. dot : integer;
  199. places,code : integer;
  200.  
  201. begin
  202.   places := 0;  { assume no decimals }
  203.   tempfmt := stupcase(trim(fstr));
  204.   dot := pos('D',tempfmt);           { wants to specify decimal places }
  205.   if dot <> 0 then begin
  206.     val(copy(tempfmt,dot+1,1),places,code);  { number of decimal places }
  207.   end;
  208.   str(number:24:places, temp1);      { create a string from real}
  209.   fmtreal := fmtstr(fstr,temp1)      { use regular string converter for rest}
  210. end;
  211.  
  212. begin
  213. end.
  214.